home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / tttsrc51.zip / IOTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  62KB  |  1,882 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10                              }
  5. {                                 (Europe)                                 }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.                      {--------------------------------}
  12.                      {       Unit:    IOTTT5          }
  13.                      {--------------------------------}
  14. {Change history:  2/24/89 5.00a    Added default Jump_Full setting line 900
  15.                   2/26/89 5.00b    Added exit statement line 1339
  16.                   2/28/89 5.00c    Modified insert proc line 1497
  17.                           5.00d    Expanded Display_All_Fields line 1188
  18.                   3/05/89 5.00e    Changed default Allow_Esc to true
  19.                           5.00f    Reduced size of Table Settings structure
  20.                   3/12/89 5.00g    Added cursor keys etc. to Allow_Char logic
  21.                                    lines 226 & 1568
  22.                           5.00h    Modified field rules logic to permit
  23.                                    Field_Rules to be called before XXX_Field
  24.                                    e.g. Real_Field
  25.                           5.00i    Changed Cursor positioning logic for
  26.                                    fields  line 593, 1315, 1331
  27.                           5.00j    Improved insert procedure and added proc
  28.                                    Init_Insert_Mode;
  29.                           5.00k    Corrected Refresh_Fields bug in non IOFULL
  30.                                    state.
  31.                           5.00l    Changed Erase_Default logic to work when
  32.                                    jumping
  33.                           5.00m    Added Enter Field Hook for first field
  34.             April 1, 89   5.01     Added error checking for TableSet,
  35.                                    and changed error level on fatal
  36.                           5.01a    Added debug compiler directive, fixed
  37.                                    global erase, remove references to VER50
  38.                           5.01b    Fixed AllowNull for string fields
  39.                           5.01c    Added a Update_Variables proc for hooks
  40.                           5.01d    Allowed Leave_Field_Hook to force back
  41.                                    to current field.
  42.              Sep 30, 89   5.02     Changed minimum logic in real/int/longint
  43.                                    fields.
  44.              Oct 9, 89    5.02a    modified dis_allow Char in
  45.                                    Field Rules.
  46.              Jan 24, 90   5.02b    changed cursor movement logic for fields
  47.                                    ending in a mask character.
  48.              Feb 22, 90   5.02c    Changed field validation for null fields
  49.              Jul 31, 90   5.02d    Remove last message when finished
  50.              01/04/93     5.10     DPMI compatible version
  51. }
  52. {$S-,R-,V-}
  53.  
  54. {$IFNDEF DEBUG}
  55. {$D-}
  56. {$ENDIF}
  57.  
  58. Unit IOTTT5;
  59. (*
  60. {$DEFINE IOFULL}
  61. *)
  62. INTERFACE
  63.  
  64. uses CRT, FastTTT5, DOS, WinTTT5, KeyTTT5, StrnTTT5, MiscTTT5;
  65.  
  66. CONST
  67. MaxTables      = 10;       {alter as necessary}
  68. MaxInputFields = 40;       {alter as necessary}
  69. IntCharacters: set of char = [#129, #132,#142,#148,#153,#154,#225]; {international users modify for your country}
  70. IOUndefined = 0;
  71. {$IFDEF IOFULL}
  72. IOString   = 1;
  73. IOByte     = 2;
  74. IOWord     = 3;
  75. IOInteger  = 4;
  76. IOLongInt  = 5;
  77. IOReal     = 6;
  78. IOPassword = 7;
  79. IOSelect   = 8;
  80. IODate     = 9;
  81.  
  82. AllowNull    = $01;
  83. SuppressZero = $02;
  84. RightJustify = $04;
  85. EraseDefault = $08;
  86. JumpIfFull   = $10;
  87.  
  88. Default_Allow_Null    :boolean = true;
  89. Default_Suppress_Zero :boolean = true;
  90. Default_Right_Justify :boolean = false;
  91. Default_Erase_Default :boolean = false;
  92. Default_Jump_Full     :boolean = false;
  93. Default_Allow_Char    :set of char = [#0];
  94. Default_DisAllow_Char :set of char = [#0];
  95. {$ENDIF}
  96. Refresh_None    = 0;
  97. Refresh_Current = 1;
  98. Refresh_All     = 2;
  99. End_Input       = 99;
  100. No_Char         = #0;
  101.  
  102. TYPE
  103. {$IFNDEF VER40}
  104. Move_Field_Proc = procedure(var CurrentField:byte;var Refresh:byte);
  105. Char_Hook_Proc   = procedure(var Ch : char; var CurrentField:byte;var Refresh:byte);
  106. Insert_Proc      = procedure(Insert:boolean);
  107. {$ENDIF}
  108.  
  109. IOCharSet = Set of char;
  110. Str_Field_Defn = record
  111.       Upfield   : byte;
  112.       Downfield : byte;
  113.       Leftfield : byte;
  114.       Rightfield: byte;
  115.       X         : byte;
  116.       Y         : byte;
  117.       Message   : strscreen;        {5.00f}
  118.       MsgX      : byte;
  119.       MsgY      : byte;
  120.       CursorX   : byte;
  121.       StrLocX   : byte;
  122.       FieldLen  : byte;
  123.       FieldStr  : strscreen;
  124.       FieldFmt    : strscreen;       {5.00f}
  125.       Right_Justify : boolean;
  126.       {$IFDEF IOFULL}
  127.       RealDP        : byte;
  128.       Allow_Null    : boolean;
  129.       Suppress_Zero : Boolean;
  130.       Erase_Default : boolean;
  131.       Jump_Full     : boolean;
  132.       Allow_Char    : set of char;
  133.       DisAllow_Char : set of char;
  134.       Rules_Set     : Boolean;    {5.00h}
  135.       case FieldType:byte of
  136.            IOString   : (SPtr: ^string);
  137.            IOByte     : (BPtr: ^Byte;BMax:byte;BMin:byte);
  138.            IOWord     : (WPtr: ^Word;WMax:word;WMin:word);
  139.            IOInteger  : (IPtr: ^Integer;IMax:integer;IMin:Integer);
  140.            IOLongInt  : (LPtr: ^LongInt;LMax:longint;LMin:longInt);
  141.            IOReal     : (RPtr: ^Real;RMax:real;RMin:Real);
  142.            IODate     : (DPtr: ^Dates;DFormat:byte;DMax:Dates;DMin:Dates);
  143.       {$ELSE}
  144.       FieldType : byte;
  145.       SPtr : ^string;
  146.       {$ENDIF}
  147. end;
  148.  
  149. Str_Field_Ptr = ^Str_Field_Defn;
  150.  
  151. TableSettings = record
  152.      HiFCol  : byte;
  153.      HiBCol  : byte;
  154.      LoFCol  : byte;
  155.      LoBCol  : byte;
  156.      MsgFCol : byte;
  157.      MsgBCol : byte;
  158.      TotalFields: byte;
  159.      CurrentField : byte;
  160.      AllowEsc : boolean;
  161.      IO_FieldsSet : boolean;
  162.      Displayed   : boolean;
  163.      Beep : boolean;
  164.      WhiteSpace : char;
  165.      ErrorLine : byte;
  166.      Insert : boolean;
  167.      {$IFNDEF VER40}
  168.      LeaveFieldHook : Move_Field_Proc;
  169.      EnterFieldHook : Move_Field_Proc;
  170.      CharHook   : Char_Hook_Proc;
  171.      InsertProc : Insert_Proc;
  172.      {$ENDIF}
  173.      FinishChar : char;
  174. end;
  175.  
  176. TableRec = record
  177.      FieldDefn: array[0..MaxInputFields] of Str_Field_Ptr;
  178.      ITTT: TableSettings;
  179. end;
  180.  
  181. TablePtr = ^TableRec;
  182.  
  183. VAR
  184.   CurrentTable : byte;
  185.   TableSet: boolean;
  186.   TotalTables : byte;
  187.   Table : array[1..MaxTables] of TablePtr;
  188.   I_Char : char;
  189.   {$IFDEF VER40}
  190.   IO_LeaveHook,
  191.   IO_EnterHook,
  192.   IO_CharHook,
  193.   IO_InsertHook : pointer;
  194.   {$ENDIF}
  195.  
  196. Procedure Create_Tables(No_Of_Tables:byte);
  197. Procedure Activate_Table(Table_no:byte);
  198. {$IFNDEF VER40}
  199. Procedure Assign_LeaveFieldHook(Proc:Move_Field_Proc);
  200. Procedure Assign_EnterFieldHook(Proc:Move_Field_Proc);
  201. Procedure Assign_CharHook(Proc:Char_Hook_Proc);
  202. Procedure Assign_InsHook(Proc:Insert_Proc);
  203. {$ENDIF}
  204. Procedure Create_Fields(No_of_fields:byte);
  205. Procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  206. Procedure Add_Message(DefID,DefX,DefY : byte; DefString : string);
  207. Procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  208. Procedure String_Field(DefID:byte;var Strvar:String;DefFormat:string);
  209. {$IFDEF IOFULL}
  210. Procedure Assign_Finish_Char(Ch : char);
  211. Procedure Byte_Field(DefID:byte;var ByteVar:Byte;DefFormat:string;Min,Max:byte);
  212. Procedure Word_Field(DefID:byte;var Wordvar:Word;DefFormat:string;Min,Max:word);
  213. Procedure Integer_Field(DefID:byte;var Integervar:Integer;DefFormat:string;Min,Max:integer);
  214. Procedure LongInt_Field(DefID:byte;var LongIntvar:LongInt;DefFormat:string;Min,Max:LongInt);
  215. Procedure Date_Field(DefID:byte;var Datevar:Dates;DateFormat:byte;DefFormat:string;
  216.                       Min,Max : Dates);
  217. Procedure Real_Field(DefID:byte;var Realvar:Real;DefFormat:string;Min,Max:real);
  218. Procedure Set_Default_Rules(Rules:word);
  219. Procedure Field_Rules(DefID:byte;Rules:word;AChar:IOcharset;DChar:IOcharset);
  220. {$ENDIF}
  221. Procedure Update_Variables;   {fix 5.01 c}
  222. Procedure Display_All_Fields;
  223. Procedure Allow_Esc(OK:boolean);
  224. Procedure Allow_Beep(OK:boolean);
  225. Procedure Init_Insert_Mode(ON:boolean);         {5.00j}
  226. Procedure Dispose_Fields;
  227. Procedure Dispose_Tables;
  228. Procedure Process_Input(StartField:byte);
  229.  
  230. implementation
  231.  
  232. Const
  233.     Valid    = 0;
  234.     NotValid = 1;
  235.     EscValid = 2;
  236.  
  237.     FmtChars  : set of char = ['!','#','@','*'];
  238.     IOUp       = #200;
  239.     IODown     = #208;
  240.     IORight    = #205;
  241.     IOLeft     = #203;
  242.     IODel      = #211;
  243.     IOTotErase = #146;    {Alt-E}
  244.     IOErase    = #160;    {Alt-D}
  245.     IOFinish   = #196;    {F10}   {can be over ridden with ASSIGN_FINISH_CHAR}
  246.     IOEsc      = #27;
  247.     IOTab      = #9;
  248.     IOShiftTab = #143;
  249.     IOEnter    = #13;
  250.     IOIns      = #210;
  251.     IOBackSp   = #8;
  252.     IORightFld = #244;
  253.     IOLeftFld  = #243;
  254.     Control_Char : set of char = [IOUp,IODown,IORight,IOLeft,IODel,    {5.00g}
  255.                                   IOTotErase,IOErase, IOEsc,
  256.                                   IOTab, IOShiftTab, IOEnter, IOIns,
  257.                                   IOBackSp, IORightFld, IOLeftFld];
  258. VAR
  259.    FirstCharPress : boolean;
  260.  
  261. {$F+}
  262. procedure NoFieldHook(var CurrentField:byte;var Refresh:byte);
  263. begin
  264. end;
  265.  
  266. procedure NoCharHook(var Ch : char; var CurrentField:byte;var Refresh:byte);
  267. begin
  268. end;
  269.  
  270. Procedure DefaultInsertHook(On:boolean);
  271. begin
  272.     If ON then
  273.        OnCursor
  274.     else
  275.        FullCursor;
  276. end;
  277. {$F-}
  278.  
  279. {$IFDEF VER40}
  280. Procedure CallEnterFieldHook(var CurrentField:byte;var Refresh:byte);
  281.           Inline($FF/$1E/IO_EnterHook);
  282.  
  283. Procedure CallLeaveFieldHook(var CurrentField:byte;var Refresh:byte);
  284.           Inline($FF/$1E/IO_LeaveHook);
  285.  
  286. Procedure CallCharHook(var Ch : char; var CurrentField:byte;var Refresh:byte);
  287.           Inline($FF/$1E/IO_CharHook);
  288.  
  289. Procedure CallInsertHook(On:boolean);
  290.           Inline($FF/$1E/IO_InsertHook);
  291. {$ENDIF}
  292.  
  293. Procedure IOTTT_Error(Code:byte;value:real);    {fatal error -- msg and halt}
  294. var Message:string;
  295. begin
  296.     Case Code of
  297.     1 : Message := 'Error 1: Invalid value of '+Real_to_Str(value,0)
  298.                    +' in Create_Fields with a MaxInputFields of '
  299.                    +Real_to_Str(MaxInputFields,0);
  300.     2 : Message := 'Error 2 : Insufficient Memory on Heap. Available '
  301.                    +Real_to_Str(MaxAvail,0)+'. Required '
  302.                    +Real_to_Str(value,0);
  303.     3 : Message := 'Error 3 : Field operation not allowed before before Create_Fields';
  304.     4 : Message := 'Error 4 : Field ID: '
  305.                    +Real_to_Str(value,0)+' out of range';
  306.     5 : Message := 'Error 5 : cannot change fields, invalid target field ID: '
  307.                    +Real_to_Str(value,0);
  308.     6 : message := 'Error 6 : Invalid X or Y value defined in Add_Field ID: '
  309.                    +Real_to_Str(value,0);
  310.     7 : Message := 'Error 7 : Cannot Add_message before calling Add_Field';
  311.     8 : Message := 'Error 8 : Cannot Add_Message, invalid Field ID: '+Real_to_Str(value,0);
  312.     9 : message := 'Error 9 : Invalid X or Y coordinate defined in Add_Message ID: '
  313.                    +Real_to_Str(value,0);
  314.     10 : Message := 'Error 10 : Cannot Dispose_fields, no fields exist';
  315.     11 : Message := 'Error 11 : Cannot Create_Fields - fields already created,'
  316.                     +' reset with Dispose_fields';
  317.     12 : Message := 'Error 12 : Use Create_Tables before Activate_Table';
  318.     13 : Message := 'Error 13 : Cannot Activate_Table - Table outside range';
  319.     14 : Message := 'Error 14 : call Create_Tables or Create_Fields first';
  320.     else Message := 'Aborting';
  321.     end; {case}
  322.     WriteAT(1,12,black,lightgray,Message);
  323.     Repeat Until keypressed;
  324.     Halt(10);     {IO fatal error returns an error level of 10}  {5.01}
  325. end;    {proc IOTTT_Error}
  326.  
  327. Procedure Ding;
  328. begin
  329.     If Table[CurrentTable]^.ITTT.Beep then
  330.     begin
  331.        sound(750);delay(150);nosound;
  332.     end;
  333. end;    {proc Ding}
  334.  
  335. Procedure Reset_Table(var T: TableSettings);
  336. begin
  337.     with T do
  338.     begin
  339.         HiFCol := white;
  340.         HiBCol := blue;
  341.         LoFCol := blue;
  342.         LoBCol := lightgray;
  343.         MsgFCol:= yellow;
  344.         MsgBCol:= red;
  345.         TotalFields:=MaxInputFields;
  346.         CurrentField := 1;
  347.         AllowEsc := true;                  {5.00e}
  348.         IO_FieldsSet := false;
  349.         Displayed    := false;
  350.         Beep    := true;
  351.         WhiteSpace   := #250;
  352.         ErrorLine := 24;
  353.         Insert := true;
  354.         {$IFNDEF VER40}
  355.         LeaveFieldHook := NoFieldHook;
  356.         EnterFieldHook := NoFieldHook;
  357.         CharHook := NoCharHook;
  358.         InsertProc := DefaultInsertHook;
  359.         {$ELSE}
  360.         IO_LeaveHook  := nil;
  361.         IO_EnterHook  := nil;
  362.         IO_CharHook   := nil;
  363.         IO_InsertHook := @DefaultInsertHook;
  364.         {$ENDIF}
  365.         FinishChar := IOFinish;
  366.     end;
  367. end;
  368.  
  369. Procedure Create_Tables(No_Of_Tables:byte);
  370. var
  371.   I:integer;
  372.   Room_needed : integer;
  373. begin
  374.     If No_of_Tables in [1..MaxTables] then
  375.     begin
  376.         Room_needed := sizeof(Table[1]^);
  377.         For I := 1 to No_of_Tables do
  378.         begin
  379.             If MaxAvail >= Room_needed then
  380.             begin
  381.                 GetMem(Table[I],Room_Needed);
  382.                 Reset_Table(Table[I]^.ITTT)
  383.             end
  384.             else  {not enough heap space}
  385.                     IOTTT_Error(2,Room_needed); {end MemAvail If clause}
  386.         end;
  387.         TotalTables := No_Of_Tables;
  388.     end;
  389.     TableSet := true;
  390. end;   {IO_SetTables}
  391.  
  392.  Procedure Activate_Table(Table_No:byte);
  393.  {}
  394.  begin
  395.      If not TableSet then
  396.         IOTTT_Error(12,0.0);
  397.      If Table_No > TotalTables then
  398.         IOTTT_Error(13,0.0);
  399.      CurrentTable := Table_No
  400.  end; {of proc Activate_Table}
  401. {$IFNDEF VER40}
  402.  
  403.  Procedure Assign_LeaveFieldHook(Proc:Move_Field_Proc);
  404.  {}
  405.  begin
  406.      If not TableSet then
  407.         IOTTT_Error(14,0.0);
  408.      Table[CurrentTable]^.ITTT.LeaveFieldHook := proc;
  409.  end; {of proc Assign_Field_Proc}
  410.  
  411.  Procedure Assign_EnterFieldHook(Proc:Move_Field_Proc);
  412.  {}
  413.  begin
  414.      Table[CurrentTable]^.ITTT.EnterFieldHook := proc;
  415.  end; {of proc Assign_Field_Proc}
  416.  
  417.  Procedure Assign_CharHook(Proc:Char_Hook_Proc);
  418.  {}
  419.  begin
  420.      If not TableSet then
  421.         IOTTT_Error(14,0.0);
  422.      Table[CurrentTable]^.ITTT.CharHook := proc;
  423.  end; {of proc Assign_Char_Proc}
  424.  
  425.  Procedure Assign_InsHook(Proc:Insert_Proc);
  426.  {}
  427.  begin
  428.      If not TableSet then
  429.         IOTTT_Error(14,0.0);
  430.      Table[CurrentTable]^.ITTT.InsertProc := proc;
  431.  end; {of proc Assign_Char_Proc}
  432. {$ENDIF}
  433.  
  434.  Procedure Assign_Finish_Char(Ch : char);
  435.  {}
  436.  begin
  437.      If not TableSet then
  438.         IOTTT_Error(14,0.0);
  439.      Table[CurrentTable]^.ITTT.FinishChar := Ch;
  440.  end; {of proc Assign_Finish_Char}
  441.  
  442. {$IFDEF IOFULL}
  443.  Procedure Set_Default_Rules(Rules:word);
  444.  {}
  445.  begin
  446.      If not TableSet then
  447.         IOTTT_Error(14,0.0);
  448.      Default_Allow_Null    := (Rules and AllowNull) = AllowNull;
  449.      Default_Suppress_Zero := (Rules and SuppressZero) = SuppressZero;
  450.      Default_Right_Justify := (Rules and RightJustify) = RightJustify;
  451.      Default_Erase_Default := (Rules and EraseDefault) = EraseDefault;
  452.      Default_Jump_Full     := (Rules and JumpIfFull) = JumpIfFull;
  453.  end; {of proc Set_Default_Rules}
  454. {$ENDIF}
  455.  
  456. Procedure Create_Fields(No_of_fields:byte);
  457. var
  458.   I:integer;
  459.   Room_needed : integer;
  460. begin
  461.     If not TableSet then
  462.        Create_Tables(1);
  463.     with Table[CurrentTable]^ do
  464.     begin
  465.     (*
  466.         If ITTT.IO_FieldsSet then IOTTT_Error(11,0);       {already set}
  467.     *)
  468.         If No_of_Fields in [1..MaxInputFields] then
  469.         begin
  470.             Room_needed := sizeof(FieldDefn[0]^);
  471.             For I := 0 to No_of_fields do
  472.             begin
  473.                 If MaxAvail >= Room_needed then
  474.                 begin
  475.                     GetMem(FieldDefn[I],Room_Needed);
  476.                     with FieldDefn[I]^ do
  477.                     begin
  478.                         Message     := '';
  479.                         MsgX        := 81;     {zero means auto-center}
  480.                         MsgY        := 0;
  481.                         FieldType   := IOUndefined;
  482.                         SPtr        := nil;
  483.                         FieldLen    := 0;
  484.                         FieldStr    := '';
  485.                         FieldFmt    := '';
  486.                         Right_Justify := false;
  487.                         {$IFDEF IOFULL}
  488.                         Rules_Set := False;     {5.00h}
  489.                         {$ENDIF}
  490.                     end;   {With}
  491.                 end
  492.                 else  {not enough heap space}
  493.                     IOTTT_Error(2,Room_needed); {end MemAvail If clause}
  494.             end;
  495.             ITTT.TotalFields := No_of_Fields;
  496.             ITTT.IO_FieldsSet := true;
  497.         end
  498.         else  {Invalid No_of_fields}
  499.            IOTTT_Error(1,No_of_fields);
  500.    end; {with table}
  501. end;  {Proc Create_Fields}
  502.  
  503.  Procedure Define_Colors(HiF,HiB,LoF,LoB,MsgF,MsgB:byte);
  504.  {}
  505.  begin
  506.      If not TableSet then
  507.         IOTTT_Error(14,0.0);
  508.      With Table[CurrentTable]^.ITTT do
  509.      begin
  510.          HiFCol := HiF;
  511.          HiBCol := HiB;
  512.          LoFCol := LoF;
  513.          LoBCol := LoB;
  514.          MsgFCol := MsgF;
  515.          MsgBCol := MsgB;
  516.      end;
  517.  end;    {Proc Define_Colors}
  518.  
  519.  Procedure Check_Field_Number(DefId : byte);
  520.  {internal}
  521.  begin
  522.      If not TableSet then
  523.         IOTTT_Error(14,0.0);
  524.      with Table[CurrentTable]^ do
  525.      begin
  526.          If not ITTT.IO_FieldsSet then IOTTT_Error(3,0);
  527.          If (DefID < 1) or (DefID>ITTT.TotalFields) then
  528.             IOTTT_Error(4,Defid);
  529.      end;
  530.  end; {of proc Check_Field_Number}
  531.  
  532. Procedure Add_Field(DefID,DefU,DefD,DefL,DefR,DefX,DefY:byte);
  533. begin
  534.     with Table[CurrentTable]^ do
  535.     begin
  536.         Check_Field_Number(DefID);
  537.         If  (DefX < 1) or (DefX > 80)
  538.         or  (DefY < 1) or (DefY > DisplayLines) then
  539.            IOTTT_Error(6,Defid);
  540.         With FieldDefn[DefID]^ do
  541.         begin
  542.             If DefU <= ITTT.TotalFields then
  543.                Upfield    := DefU;
  544.             If DefD <= ITTT.TotalFields then
  545.                Downfield  := DefD;
  546.             If DefL <= ITTT.TotalFields then
  547.                Leftfield  := DefL;
  548.             If DefR <= ITTT.TotalFields then
  549.                Rightfield := DefR;
  550.             X          := DefX;
  551.             Y          := DefY;
  552.         end;
  553.    end; {with Table}
  554. end; {proc ADD_Field}
  555.  
  556. Procedure Add_Message(DefID,DefX,DefY : byte; DefString : string);
  557. begin
  558.     Check_Field_Number(DefId);   {5.01}
  559.     with Table[CurrentTable]^ do
  560.     begin
  561.         If not ITTT.IO_FieldsSet then IOTTT_Error(7,0);
  562.         If (DefID < 1) or (DefID > ITTT.TotalFields) then IOTTT_Error(8,DefID);
  563.         If (DefX < 0) or (DefX > 80) or (DefY < 1) or (DefY > 25) then IOTTT_Error(9,DefID);
  564.         With FieldDefn[Defid]^ do
  565.         begin
  566.             MsgX := DefX;
  567.             MsgY := DefY;
  568.             Message := DefString;
  569.         end;
  570.     end; {with Table}
  571. end;  {proc ADD_Message}
  572.  
  573.  Function Max_string_length(DefFormat:string) : byte;
  574.  var I,Counter : byte;
  575.  begin
  576.      Counter := 0;
  577.      For I := 1 to length(DefFormat) do
  578.          if (DefFormat[I] in FmtChars) then
  579.             Counter := succ(counter);
  580.      Max_string_length := Counter;
  581.  end;  {sub func Max_String_Length}
  582.  
  583.  Function  Last_Char_Left_Justified(Str,Fmt:string): byte;
  584.  var
  585.     LenS,LenF,S,
  586.     Counter : byte;
  587.  begin
  588.      Counter := 0;
  589.      S := 0;
  590.      LenF := Length(Fmt);
  591.      LenS := Length(Str);
  592.      Repeat
  593.           Inc(Counter);
  594.           If Fmt[Counter] in FmtChars then
  595.              Inc(S);
  596.      Until (S > LenS) or (Counter > LenF);
  597.      Last_Char_Left_Justified := counter;
  598.  end;
  599.  
  600.  Function  Pos_of_Last_Input_Char(DefFormat:string): byte;
  601.  var
  602.     Counter : byte;
  603.  begin
  604.      Counter := Succ(Length(DefFormat));
  605.      Repeat
  606.           Dec(Counter);
  607.      Until (DefFormat[Counter] in FmtChars) or (Counter = 0);
  608.      Pos_of_Last_Input_Char := counter;
  609.  end;
  610.  
  611. Procedure Set_Cursor(DefID:byte);
  612. begin
  613.     with Table[CurrentTable]^.FieldDefn[DefID]^ do
  614.     begin
  615. {$IFDEF IOFULL}
  616.         If Right_Justify then
  617.         begin
  618.             CursorX := pred(X) + Pos_of_Last_Input_Char(FieldFmt);
  619.             StrLocX := length(FieldStr);
  620.         end
  621.         else       {left Justified}
  622.         begin
  623. {$ENDIF}
  624.            If FieldStr = '' then
  625.               StrLocX := 1
  626.            else
  627.            begin
  628.                StrLocX := succ(Length(FieldStr));
  629.                If StrLocX > FieldLen then
  630.                   StrLocX := FieldLen;
  631.            end;
  632.            CursorX := Last_Char_Left_Justified(FieldStr,FieldFmt);
  633.            If CursorX > length(FieldFmt) then       {5.00 I}
  634.               dec(CursorX);
  635.            while ( (FieldFmt[CursorX] in FmtChars) = false)   {5.02b}
  636.            and   (CursorX > 0) do
  637.               dec(CursorX);
  638.            CursorX := CursorX + pred(X);
  639. {$IFDEF IOFULL}
  640.         end;
  641. {$ENDIF}
  642.     end;
  643. end;
  644.  
  645.  
  646. Function Var_To_String(DefID : byte):String;
  647. var Str : string;
  648. begin
  649.     with Table[CurrentTable]^.FieldDefn[DefID]^ do
  650.     begin
  651. {$IFDEF IOFULL}
  652.         Case FieldType of
  653.         IOString  : Str := SPtr^;
  654.         IOByte    : If Suppress_Zero and (BPtr^ = 0) then
  655.                        Str := ''
  656.                     else
  657.                        Str := Int_To_Str(BPtr^);
  658.         IOWord    : If Suppress_Zero and (WPtr^ = 0) then
  659.                        Str := ''
  660.                     else
  661.                        Str := Int_To_Str(WPtr^);
  662.         IOInteger : If Suppress_Zero and (IPtr^ = 0) then
  663.                        Str := ''
  664.                     else
  665.                        Str := Int_To_Str(IPtr^);
  666.         IOLongInt : If Suppress_Zero and (LPtr^ = 0) then
  667.                        Str := ''
  668.                     else
  669.                        Str := Int_To_Str(LPtr^);
  670.         IODate    : If Suppress_Zero and (DPtr^ = 0) then
  671.                        Str := ''
  672.                     else
  673.                        Str := Unformatted_date(Julian_to_date(WPtr^,DFormat));
  674.         IOReal    : If Suppress_Zero and (RPtr^ = 0.0) then
  675.                        Str := ''
  676.                     else
  677.                     begin
  678.                         Str := Real_To_Str(RPtr^,RealDP);
  679.                         If RealDP <> Floating then
  680.                             Delete(Str,LastPos('.',Str),1);
  681.                     end;
  682.         end; {case}
  683. {$ELSE}
  684.       Str := SPtr^;
  685. {$ENDIF}
  686.     end;   {with}
  687.     Var_To_String := Str;
  688.     Set_Cursor(DefID);
  689.  end; {func Var_To_String}
  690.  
  691.  Function Formatted_String(Str,Fmt:string;RJ:boolean):string;
  692.  var
  693.  TempStr : string;
  694.  I,J : byte;
  695.  K : integer;
  696.  begin
  697. {$IFDEF IOFULL}
  698.      If RJ then
  699.      begin
  700.          J := succ(Length(Fmt));
  701.          K := length(Str);
  702.          For I := length(Fmt) downto 1 do
  703.          begin
  704.              If not (Fmt[I] in FmtChars) then
  705.              begin
  706.                  TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  707.                  dec(J);
  708.              end
  709.              else    {format character}
  710.              begin
  711.                  If K > 0  then
  712.                     TempStr[I] := Str[K]
  713.                  else
  714.                     TempStr[I] := Table[CurrentTable]^.ITTT.WhiteSpace;
  715.                  Dec(K);
  716.              end;
  717.          end;
  718.      end
  719.      else   {left Justified}
  720.      begin
  721. {$ENDIF}
  722.          J := 0;
  723.          For I := 1 to length(Fmt) do
  724.          begin
  725.              If not (Fmt[I] in FmtChars) then
  726.              begin
  727.                  TempStr[I] := Fmt[I] ;  {force any none format charcters into string}
  728.                  inc(J);
  729.              end
  730.              else    {format character}
  731.              begin
  732.                  If I - J <= length(Str) then
  733.                     TempStr[I] := Str[I - J]
  734.                  else
  735.                     TempStr[I] := Table[CurrentTable]^.ITTT.WhiteSpace;
  736.              end;
  737.          end;
  738. {$IFDEF IOFULL}
  739.      end;
  740. {$ENDIF}
  741.      TempStr[0] := char(length(Fmt));  {set initial byte to string length}
  742.      Formatted_String := Tempstr;
  743.  end;  {Func Formatted_String}
  744.  
  745. {$IFDEF IOFULL}
  746.  Procedure Invalid_Message(var CH : char);
  747.  begin
  748.    Ding;
  749.    With Table[CurrentTable]^.ITTT do
  750.    TempMessageCH(1,ErrorLine,MsgFCol,MsgBCol,
  751.                PadCenter('Invalid number - press any key ... and make correction!',80,' '),CH);
  752.  end;
  753.  
  754.  Procedure Invalid_Date_Message(var CH : char;Format:byte);
  755.  var FmtStr : string;
  756.  begin
  757.    Ding;
  758.    Case Format of
  759.    MMDDYY   : FmtStr := 'MM/DD/YY';
  760.    MMDDYYYY : FmtStr := 'MM/DD/YYYY';
  761.    MMYY     : FmtStr := 'MM/YY';
  762.    MMYYYY   : FmtStr := 'MM/YYYY';
  763.    DDMMYY   : FmtStr := 'DD/MM/YY';
  764.    DDMMYYYY : FmtStr := 'DD/MM/YYYY';
  765.    end; {case}
  766.    With Table[CurrentTable]^.ITTT do
  767.    TempMessageCH(1,ErrorLine,MsgFCol,MsgBCol,
  768.                PadCenter('Error format is '+FmtStr+'  - press any key ... and make correction!',80,' '),CH);
  769.  end;
  770.  
  771.  Procedure OutOfRange_Message(MinS,MaxS : StrScreen;var CH:char);
  772.  var
  773.    S : StrScreen;
  774.  begin
  775.      Ding;
  776.      S := 'Error value must be in the range '+MinS+' to '+MaxS+' - press any key & correct';
  777.      With Table[CurrentTable]^.ITTT do
  778.           TempMessageCh(1,ErrorLine,MsgFCol,MsgBCol,PadCenter(S,80,' '),CH);
  779.  end;
  780.  
  781.  Procedure Validate_Field(DefID:byte; var result:byte);
  782.  {}
  783.  var
  784.    VL : longint;
  785.    VR : Real;
  786.    ChV : char;
  787.    RetCode : integer;
  788.  
  789.    Procedure Check_Number(Min,Max: longint;
  790.                           Len : byte;
  791.                           StrMax : string);
  792.    {}
  793.    begin
  794.        with Table[CurrentTable]^.FieldDefn[DefID]^ do
  795.        begin
  796.            If (FieldStr = '') and Suppress_Zero then {5.02c}
  797.            begin
  798.                VL := 0;
  799.                Retcode := 0;
  800.            end
  801.            else
  802.               val(FieldStr,VL,Retcode);
  803.            If Retcode <> 0 then
  804.            begin
  805.                Invalid_Message(ChV);
  806.                If ChV = #027 then
  807.                begin
  808.                   Result := EscValid;
  809.                   FieldStr := Var_To_String(DefID);
  810.                end
  811.                else
  812.                   Result := NotValid;
  813.            end
  814.            else
  815.            begin
  816.                If (VL < Min)
  817.                or (VL > Max)
  818.                or ((length(FieldStr) > Len) and (FieldStr > StrMax)) then
  819.                begin
  820.                   OutOfRange_Message(Int_To_Str(Min),Int_To_Str(Max),ChV);
  821.                   If ChV = #027 then
  822.                   begin
  823.                      FieldStr := Var_To_String(DefID);
  824.                      Result := EscValid;
  825.                   end
  826.                   else
  827.                      Result := NotValid;
  828.                end
  829.                else
  830.                begin
  831.                    Result := valid;
  832.                end;
  833.            end;
  834.        end; {with}
  835.    end; {of proc Check_Number}
  836.  
  837.    Procedure Check_date;
  838.    {}
  839.    begin
  840.        with Table[CurrentTable]^.FieldDefn[DefID]^ do
  841.        begin
  842.            If not Valid_Date(FieldStr,DFormat) then
  843.            begin
  844.                Invalid_Date_Message(ChV,DFormat);
  845.                If ChV = #027 then
  846.                begin
  847.                   Result := EscValid;
  848.                   FieldStr := Var_To_String(DefID);
  849.                end
  850.                else
  851.                   Result := NotValid;
  852.            end
  853.            else
  854.            begin
  855.                VL := Date_to_Julian(FieldStr,DFormat);
  856.                If (VL < DMin)
  857.                or (VL > DMax) then
  858.                begin
  859.                   OutOfRange_Message(Julian_to_date(DMin,DFormat),Julian_to_date(DMax,DFormat),ChV);
  860.                   If ChV = #027 then
  861.                   begin
  862.                      FieldStr := Var_To_String(DefID);
  863.                      Result := EscValid;
  864.                   end
  865.                   else
  866.                      Result := NotValid;
  867.                end
  868.                else
  869.                begin
  870.                    Result := valid;
  871.                end;
  872.            end;
  873.        end; {with}
  874.    end; {of proc Check_date}
  875.  
  876.  begin
  877.      Result := Valid; {assume alls well}
  878.      with Table[CurrentTable]^ do
  879.           with FieldDefn[DefID]^ do
  880.      begin
  881.          If (FieldStr = '') and Allow_Null then
  882.             exit;
  883.          Case FieldType of
  884.          IOString  : If FieldStr = '' then
  885.                      begin
  886.                         Result := NotValid;
  887.                         Ding;
  888.                      end;
  889.          IOByte    : Check_Number(BMin,BMax,2,'255');
  890.          IOWord    : Check_Number(WMin,WMax,4,'65535');
  891.          IOInteger : Check_Number(IMin,IMax,5,'32767');
  892.          IOLongInt : Check_Number(LMin,LMax,11,'2147483647');
  893.          IODate    : Check_Date;
  894.          IOReal    : begin
  895.                          val(  Strip('B',ITTT.WhiteSpace,
  896.                                      Formatted_String(FieldStr,FieldFmt,Right_Justify)),
  897.                                VR,
  898.                                Retcode
  899.                             );
  900.                          If Retcode <> 0 then
  901.                          begin
  902.                              Invalid_Message(ChV);
  903.                              If ChV = #027 then
  904.                              begin
  905.                                 Result := EscValid;
  906.                                 FieldStr := Var_To_String(DefID);
  907.                              end
  908.                              else
  909.                                 Result := NotValid;
  910.                          end
  911.                          else
  912.                          begin
  913.                              If (VR < RMin)
  914.                              or (VR > RMax) then
  915.                              begin
  916.                                 OutOfRange_Message(Real_To_Str(RMin,RealDP),Real_To_Str(RMax,RealDP),ChV);
  917.                                 If ChV = #027 then
  918.                                 begin
  919.                                    FieldStr := Var_To_String(DefID);
  920.                                    Result := EscValid;
  921.                                 end
  922.                                 else
  923.                                    Result := NotValid;
  924.                              end
  925.                              else
  926.                              begin
  927.                                  Result := valid;
  928.                              end;
  929.                          end;
  930.                      end;
  931.          end; {case}
  932.      end;   {with}
  933.  end; {of proc Validate_Field}
  934. {$ENDIF}
  935.  
  936.  Procedure String_To_Var(DefID : byte);
  937.  begin
  938.     with Table[CurrentTable]^ do
  939.          with FieldDefn[DefID]^ do
  940. {$IFDEF IOFULL}
  941.          begin
  942.              Case FieldType of
  943.              IOString  : SPtr^ := FieldStr;
  944.              IOByte    : BPtr^ := Str_to_Int(FieldStr);
  945.              IOWord    : WPtr^ := Str_to_Int(FieldStr);
  946.              IOInteger : IPtr^ := Str_to_Int(FieldStr);
  947.              IOLongInt : LPtr^ := Str_to_Long(FieldStr);
  948.              IOReal    : RPtr^ := Str_to_Real(Strip('B',ITTT.WhiteSpace,
  949.                                               Formatted_String(FieldStr,FieldFmt,Right_Justify)));
  950.              IODate    : If FieldStr = '' then
  951.                             DPtr^ := 0
  952.                          else
  953.                             DPtr^ := Date_to_Julian(FieldStr,Dformat);
  954.              end; {case}
  955.         end;   {with}
  956. {$ELSE}
  957.        SPTR^ := FieldStr;
  958. {$ENDIF}
  959.  end; {proc String_to_var}
  960.  
  961.  
  962.  Procedure Update_Variables;   {fix 5.01 c}
  963.  {}
  964.  var I : integer;
  965.  begin
  966.      with Table[CurrentTable]^ do
  967.           For I :=  1 to ITTT.TotalFields do
  968.               String_to_var(I);
  969.  end;
  970.  
  971. {$IFDEF IOFULL}
  972.  Procedure Set_Misc_Field_Defaults(DefID:byte);
  973.  {}
  974.  begin
  975.      Check_Field_Number(DefId);   {5.01}
  976.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  977.      begin
  978.          Allow_Null    := Default_Allow_Null;
  979.          Suppress_Zero := Default_Suppress_Zero;
  980.          Right_Justify := Default_Right_Justify;
  981.          Erase_Default := Default_Erase_Default;
  982.          Allow_Char    := Default_Allow_Char;
  983.          DisAllow_Char := Default_DisAllow_Char;
  984.          Jump_Full     := Default_Jump_Full;    {fix 5.00a}
  985.          Set_Cursor(DefID);
  986.          Rules_Set := true;   {5.00h}
  987.      end;  {with}
  988.  end; {of proc Set_Misc_Field_Defaults}
  989.  
  990.  Procedure Field_Rules(DefID:byte;
  991.                        Rules:word;
  992.                        AChar: IOCharSet;
  993.                        DChar: IOCharSet);
  994.  {}
  995.  begin
  996.      Check_Field_Number(DefId);   {5.01}
  997.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  998.      begin
  999.          Allow_Null     := (Rules and AllowNull) = AllowNull;
  1000.          Suppress_Zero  := (Rules and SuppressZero) = SuppressZero;
  1001.          If (FieldType = IOReal)
  1002.          and (RealDP > 0)
  1003.          and (RealDp <> Floating) then
  1004.              Right_Justify := true       {force Right_Justify}
  1005.          else
  1006.              Right_Justify := (Rules and RightJustify) = RightJustify;
  1007.          Erase_Default := (Rules and EraseDefault) = EraseDefault;
  1008.          Jump_Full := (Rules and JumpIfFull) = JumpIfFull;
  1009.          Allow_Char    := Achar;
  1010.          If (RealDP <> Floating) and (DChar = [#0])  and (FieldType = IOReal) then
  1011.             DisAllow_Char := ['.']
  1012.          else
  1013.             DisAllow_Char := Dchar;
  1014.          FieldStr      := Var_To_String(DefID);
  1015.          Rules_Set := true;   {5.00h}
  1016.      end;  {with}
  1017.  end; {of proc Field_Rules}
  1018. {$ENDIF}
  1019.  
  1020.  Procedure String_Field(DefID:byte;
  1021.                         var Strvar:String;
  1022.                         DefFormat:string);
  1023.  {}
  1024.  begin
  1025.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1026.      begin
  1027.          Check_Field_Number(DefID);
  1028. {$IFDEF IOFULL}
  1029.          FieldType     := IOString;
  1030. {$ENDIF}
  1031.          SPtr          := @StrVar;
  1032.          FieldStr      := Sptr^;
  1033.          FieldFmt      := DefFormat;
  1034.          FieldLen      := Max_String_Length(FieldFmt);
  1035. {$IFDEF IOFULL}
  1036.          If Rules_Set then                 {5.00h}
  1037.             Set_Cursor(DefID)
  1038.          else
  1039.             Set_Misc_Field_Defaults(DefID);
  1040. {$ELSE}
  1041.          Set_Cursor(DefID);
  1042. {$ENDIF}
  1043.      end;
  1044.  end; {of proc String_Field}
  1045.  
  1046. {$IFDEF IOFULL}
  1047.  Procedure Byte_Field(DefID:byte;
  1048.                       var Bytevar:Byte;
  1049.                       DefFormat:string;
  1050.                       Min,Max : byte);
  1051.  {}
  1052.  begin
  1053.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1054.      begin
  1055.          Check_Field_Number(DefID);
  1056.          FieldType     := IOByte;
  1057.          If Rules_Set then                 {5.00h}
  1058.             Set_Cursor(DefID)
  1059.          else
  1060.             Set_Misc_Field_Defaults(DefID);
  1061.          SPtr          := @Bytevar;
  1062.          FieldStr := Var_To_String(DefID);
  1063.          If DefFormat = '' then
  1064.             FieldFmt := '###'
  1065.          else
  1066.             FieldFmt := DefFormat;
  1067.          If (Max = 0) or (Max < Min) then
  1068.             BMax := 255
  1069.          else
  1070.             BMax := Max;
  1071.          If Min > BMax then
  1072.             BMin := 0
  1073.          else
  1074.             BMin := Min;
  1075.          FieldLen      := Max_String_Length(FieldFmt);
  1076.          Set_Cursor(DefID);             {5.00h}
  1077.      end;
  1078.  end; {of proc Byte_Field}
  1079.  
  1080.  Procedure Word_Field(DefID:byte;
  1081.                       var Wordvar:Word;
  1082.                       DefFormat:string;
  1083.                       Min,Max : word);
  1084.  {}
  1085.  begin
  1086.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1087.      begin
  1088.          Check_Field_Number(DefID);
  1089.          FieldType     := IOWord;
  1090.          If Rules_Set then                 {5.00h}
  1091.             Set_Cursor(DefID)
  1092.          else
  1093.             Set_Misc_Field_Defaults(DefID);
  1094.          SPtr          := @WordVar;
  1095.          FieldStr      := Var_to_String(DefID);
  1096.          If DefFormat = '' then
  1097.             FieldFmt := '#####'
  1098.          else
  1099.             FieldFmt := DefFormat;
  1100.          If (Max = 0) or (Max < Min) then
  1101.              WMax := 65535
  1102.          else
  1103.             WMax := Max;
  1104.          If Min > WMax then
  1105.             WMin := 0
  1106.          else
  1107.             WMin := MIn;
  1108.          FieldLen      := Max_String_Length(FieldFmt);
  1109.          Set_Cursor(DefID);          {5.00h}
  1110.      end;
  1111.  end; {of proc Word_Field}
  1112.  
  1113.  Procedure Integer_Field(DefID:byte;
  1114.                       var Integervar:Integer;
  1115.                       DefFormat:string;
  1116.                       Min,Max:Integer);
  1117.  {}
  1118.  begin
  1119.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1120.      begin
  1121.          Check_Field_Number(DefID);
  1122.          FieldType     := IOInteger;
  1123.          If Rules_Set then                 {5.00h}
  1124.             Set_Cursor(DefID)
  1125.          else
  1126.             Set_Misc_Field_Defaults(DefID);
  1127.          Set_Misc_Field_Defaults(DefID);
  1128.          SPtr          := @IntegerVar;
  1129.          FieldStr      := Var_to_String(DefID);
  1130.          If DefFormat = '' then
  1131.             FieldFmt := '######'
  1132.          else
  1133.             FieldFmt := DefFormat;
  1134.          If (Max = 0) or (Max < Min) then
  1135.             IMax := 32767
  1136.          else
  1137.             IMax := Max;
  1138.          If ((Min = 0) and (Max = 0)) or (Min > WMax) then      {5.02}
  1139.             IMin := -32768
  1140.          else
  1141.             IMin := Min;
  1142.          FieldLen      := Max_String_Length(FieldFmt);
  1143.          Set_Cursor(DefID);   {5.00h}
  1144.      end;
  1145.  end; {of proc Integer_Field}
  1146.  
  1147.  Procedure LongInt_Field(DefID:byte;
  1148.                       var LongIntvar:LongInt;
  1149.                       DefFormat:string;
  1150.                       Min,Max : LongInt);
  1151.  {}
  1152.  begin
  1153.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1154.      begin
  1155.          Check_Field_Number(DefID);
  1156.          FieldType     := IOLongInt;
  1157.          If Rules_Set then                 {5.00h}
  1158.             Set_Cursor(DefID)
  1159.          else
  1160.             Set_Misc_Field_Defaults(DefID);
  1161.          SPtr          := @LongIntVar;
  1162.          FieldStr      := Var_to_String(DefID);
  1163.          If DefFormat = '' then
  1164.             FieldFmt := '###########'
  1165.          else
  1166.             FieldFmt := DefFormat;
  1167.          If (max = 0) or (Max < Min) then
  1168.             LMax := 2147483647
  1169.          else
  1170.             LMax := Max;
  1171.          If ((Min = 0) and (Max = 0)) or (Min > LMax) then   {5.02}
  1172.             LMin := -2147483647
  1173.          else
  1174.             LMin := Min;
  1175.          FieldLen      := Max_String_Length(FieldFmt);
  1176.          Set_Cursor(DefID);           {5.00h}
  1177.      end;
  1178.  end; {of proc LongInt_Field}
  1179.  
  1180.  Procedure Date_Field(DefID:byte;
  1181.                       var Datevar:Dates;
  1182.                       DateFormat:byte;
  1183.                       DefFormat:string;
  1184.                       Min,Max : Dates);
  1185.  {}
  1186.  begin
  1187.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1188.      begin
  1189.          Check_Field_Number(DefID);
  1190.          FieldType     := IODate;
  1191.          If Rules_Set then                 {5.00h}
  1192.             Set_Cursor(DefID)
  1193.          else
  1194.             Set_Misc_Field_Defaults(DefID);
  1195.          SPtr          := @DateVar;
  1196.          If DateVar = 0 then
  1197.             FieldStr := ''
  1198.          else
  1199.             FieldStr      := Unformatted_date(Julian_to_Date(DateVar,DateFormat));
  1200.          If DefFormat = '' then
  1201.          begin
  1202.              Case DateFormat of
  1203.              DDMMYY,MMDDYY :       FieldFmt := '##/##/##';
  1204.              MMYY          :       FIeldFmt := '##/##';
  1205.              MMYYYY        :       FieldFmt := '##/####';
  1206.              DDMMYYYY,
  1207.              MMDDYYYY      :       FieldFmt := '##/##/####';
  1208.              end; {Case}
  1209.          end
  1210.          else
  1211.             FieldFmt := DefFormat;
  1212.          If (Max = 0) or (Max < Min) then
  1213.              DMax := 65535
  1214.          else
  1215.             DMax := Max;
  1216.          If Min > WMax then
  1217.             DMin := 0
  1218.          else
  1219.             DMin := MIn;
  1220.          DFormat := DateFormat;
  1221.          FieldLen      := Max_String_Length(FieldFmt);
  1222.          Set_Cursor(DefID);   {5.00h}
  1223.      end;
  1224.  end; {of proc Date_Field}
  1225.  
  1226.  Procedure Real_Field(DefID:byte;
  1227.                       var Realvar:Real;
  1228.                       DefFormat:string;
  1229.                       Min,Max : real);
  1230.  {}
  1231.  var p : byte;
  1232.  begin
  1233.      with Table[CurrentTable]^.FieldDefn[DefID]^ do
  1234.      begin
  1235.          Check_Field_Number(DefID);
  1236.          FieldType     := IOReal;
  1237.          If Rules_Set then                 {5.00h}
  1238.             Set_Cursor(DefID)
  1239.          else
  1240.             Set_Misc_Field_Defaults(DefID);
  1241.          SPtr          := @RealVar;
  1242.          If DefFormat = '' then
  1243.             FieldFmt := '############'
  1244.          else
  1245.             FieldFmt := DefFormat;
  1246.          P := LastPos('.',FieldFmt);
  1247.          If P = 0 then
  1248.             RealDP  := Floating
  1249.          else
  1250.             RealDP := Length(FieldFmt) - P;
  1251.          If RealDP = 0 then
  1252.             Delete(FieldFmt,P,1);            {remove the end decimal place}
  1253.          If (Max = 0.0) or (Max < Min) then
  1254.             RMax := 1.7E+37                  {for compatibiltity with Turbo4}
  1255.          else
  1256.             RMax := Max;
  1257.          If ((Min = 0.0) and (Max = 0.0)) or (Min > RMax) then  {5.02}
  1258.             RMin := -1.7E+37                 {for compatibiltity with Turbo4}
  1259.          else
  1260.             RMin := Min;
  1261.          If (RealDP <> 0) and (RealDP <> Floating) then
  1262.             Right_Justify := true;
  1263.          If RealDP <> Floating then
  1264.             DisAllow_Char := ['.'];
  1265.          FieldStr      := Var_to_String(DefID);
  1266.          FieldLen      := Max_String_Length(FieldFmt);
  1267.          Set_Cursor(DefID);   {5.00h}
  1268.      end;
  1269.  end; {of proc Real_Field}
  1270. {$ENDIF}
  1271.  
  1272. Procedure Hilight(ID:byte);      {display cell in bright colors}
  1273. begin
  1274.     with Table[CurrentTable]^ do
  1275.          with FieldDefn[ID]^ do
  1276.               WriteAT(X,Y,ITTT.HiFCol,ITTT.HiBCol,
  1277.                       Formatted_String(FieldStr,FieldFmt,Right_Justify));
  1278. end;
  1279.  
  1280. Procedure LoLight(ID:byte);      {display cell in dim colors}
  1281. begin
  1282.     with Table[CurrentTable]^ do
  1283.          with FieldDefn[ID]^ do
  1284.              WriteAT(X,Y,ITTT.LoFCol,ITTT.LoBCol,
  1285.                       Formatted_String(FieldStr,FieldFmt,Right_Justify));
  1286. end;
  1287.  
  1288. Procedure Display_All_Fields;
  1289. var I : integer;
  1290. begin
  1291.     If not TableSet then
  1292.         IOTTT_Error(14,0.0);  {5.01}
  1293.     with Table[CurrentTable]^ do
  1294.     begin
  1295.         For I :=  1 to ITTT.TotalFields do
  1296.         begin
  1297.             FieldDefn[I]^.FieldStr := Var_To_String(I);    {fix 5.00 d}
  1298.             Set_Cursor(I);
  1299.             LoLight(I);
  1300.         end;
  1301.         ITTT.Displayed  := true;
  1302.     end; {with Table}
  1303. end;
  1304.  
  1305. Procedure Allow_Esc(OK:boolean);
  1306. begin
  1307.     If not TableSet then
  1308.         IOTTT_Error(14,0.0);  {5.01}
  1309.     Table[CurrentTable]^.ITTT.AllowEsc := OK;
  1310. end;    {proc Allow_Esc}
  1311.  
  1312. Procedure Allow_Beep(OK:boolean);
  1313. begin
  1314.     Table[CurrentTable]^.ITTT.Beep := OK;
  1315. end;    {proc Allow_Beep}
  1316.  
  1317. Procedure Init_Insert_Mode(ON:boolean);
  1318. begin
  1319.     Table[CurrentTable]^.ITTT.Insert := ON;
  1320. end;    {proc Init_Insert_Mode}
  1321.  
  1322. Procedure Dispose_Fields;
  1323. var I : integer;
  1324. begin
  1325.     If not TableSet then
  1326.         IOTTT_Error(14,0.0);  {5.01}
  1327.     with Table[CurrentTable]^ do
  1328.     begin
  1329.         If not ITTT.IO_FieldsSet then IOTTT_Error(10,0);
  1330.         For I := 0 to ITTT.TotalFields do
  1331.             FreeMem(FieldDefn[I],sizeof(FieldDefn[I]^));
  1332.         Reset_Table(ITTT);
  1333.     end; {with Table}
  1334. end; { proc Dispose_Fields}
  1335.  
  1336. Procedure Dispose_Tables;
  1337. var I : integer;
  1338. begin
  1339.     If not TableSet then
  1340.         IOTTT_Error(14,0.0);  {5.01}
  1341.     For I := 1 to TotalTables do
  1342.         FreeMem(Table[I],sizeOf(Table[I]^));
  1343.     TotalTables := 0;
  1344. end;
  1345.  
  1346. {
  1347. ****************************
  1348. *      Main Procedure      *
  1349. ****************************
  1350. }
  1351.  
  1352. Procedure Process_Input(StartField:byte);
  1353. var
  1354.     OldLine : array[1..160] of byte;
  1355.     Finished : boolean;
  1356.     SRefresh,SField : Byte;
  1357.  
  1358.     Procedure DisplayMessage(ID:byte);
  1359.     begin
  1360.         With Table[CurrentTable]^ do
  1361.              with FieldDefn[ID]^ do
  1362.              begin
  1363.                 If MsgX = 0 then   {Center the message}
  1364.                    MsgX := (80 - length(Message)) div 2;
  1365.                 PartSave(MsgX,MsgY,MsgX+length(Message),MsgY,OldLine);
  1366.                 WriteAT(MsgX,MsgY,ITTT.MsgFCol,ITTT.MsgBCol,Message);
  1367.              end;
  1368.     end;
  1369.  
  1370.     Procedure RemoveMessage(ID:byte);
  1371.     var I,LocC : integer;
  1372.     begin
  1373.         With Table[CurrentTable]^.FieldDefn[ID]^ do
  1374.              PartRestore(MsgX,MsgY,MsgX+length(Message),MsgY,OldLine);
  1375.     end; {sub sub proc RemoveMessage}
  1376.  
  1377.     Procedure Check_Refresh_State(Refresh:byte);
  1378.     {}
  1379.     var I : integer;
  1380.     begin
  1381.         with Table[CurrentTable]^ do
  1382.         Case Refresh of
  1383. {$IFDEF IOFULL}
  1384.         Refresh_None :; {do nothing}
  1385.         Refresh_Current: begin
  1386.                              FieldDefn[ITTT.CurrentField]^.FieldStr := Var_to_String(ITTT.CurrentField);
  1387.                              Set_Cursor(ITTT.CurrentField);  {5.00i}
  1388.                              LoLight(ITTT.CurrentField);
  1389.                          end;
  1390.         Refresh_All: begin
  1391.                          Display_All_Fields;
  1392.                      end;
  1393.         End_Input : begin
  1394.                         Display_All_Fields;
  1395.                         Finished := true;
  1396.                     end;
  1397. {$ELSE}
  1398.         Refresh_None   :; {do nothing}
  1399.         Refresh_Current: begin
  1400.                              FieldDefn[I]^.FieldStr := Var_To_String(I);{5.00k}
  1401.                              Set_Cursor(ITTT.CurrentField);   {5.00i}
  1402.                              LoLight(ITTT.CurrentField);
  1403.                          end;
  1404.         Refresh_All    : Display_All_Fields;
  1405.         End_Input      : begin
  1406.                              Display_All_Fields;
  1407.                              Finished := true;
  1408.                          end;
  1409. {$ENDIF}
  1410.         end; {Case}
  1411.     end; {of proc Check_refresh_State}
  1412.  
  1413.   Procedure Change_Fields(ID:byte);
  1414.   var
  1415.     ValidInput:byte;
  1416.     CField : byte;
  1417.     Refresh : byte;
  1418.   begin
  1419.       with Table[CurrentTable]^ do
  1420.       begin
  1421. {$IFDEF IOFULL}
  1422.           Validate_Field(ITTT.CurrentField,ValidInput);
  1423.           If ValidInput <> Valid then
  1424.              exit;
  1425. {$ENDIF}
  1426.           String_to_Var(ITTT.CurrentField);
  1427.           LoLight(ITTT.CurrentField);
  1428.           If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1429.              RemoveMessage(ITTT.CurrentField);
  1430.           {Now call the "leave field" hook}
  1431.           CField := ITTT.CurrentField;
  1432.           Refresh := Refresh_None;
  1433.           {$IFNDEF VER40}
  1434.           ITTT.LeaveFieldHook(CField,Refresh);
  1435.           {$ELSE}
  1436.           If IO_LeaveHook <> Nil then
  1437.              CallLeaveFieldHook(CField,Refresh);
  1438.           {$ENDIF}
  1439.           If CField = 0 then                 {Fix 5.01d}
  1440.              ID := ITTT.CurrentField         {stay put!}
  1441.           else
  1442.           begin
  1443.               If CField <> ITTT.CurrentField then
  1444.                  ID := CField; {user wants to go to a specific field}
  1445.           end;
  1446.           Check_Refresh_State(Refresh);
  1447.           If Finished then exit;
  1448.           If ID = 0 then
  1449.           begin
  1450.               Finished := true;
  1451.           end
  1452.           else
  1453.           begin
  1454.               ITTT.CurrentField := ID;
  1455.               CField := ID;
  1456.               {Enter Field Hook}
  1457.               Repeat
  1458.                    ITTT.CurrentField := CField;
  1459.                    Refresh := Refresh_None;
  1460.                    {$IFNDEF VER40}
  1461.                    ITTT.EnterFieldHook(CField,Refresh);
  1462.                    {$ELSE}
  1463.                    If IO_EnterHook <> Nil then
  1464.                       CallEnterFieldHook(CField,Refresh);
  1465.                    {$ENDIF}
  1466.                    Check_Refresh_State(Refresh);
  1467.                    If Finished then exit;
  1468.               until CField = ITTT.CurrentField;
  1469.               If (ITTT.CurrentField < 1)
  1470.               or (ITTT.CurrentField > ITTT.TotalFields) then
  1471.                   exit;                      {5.00b}
  1472.               HiLight(ITTT.CurrentField);
  1473.               If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1474.                  DisplayMessage(ITTT.CurrentField);
  1475.               With FieldDefn[ITTT.CurrentField]^ do
  1476.                   GotoXY(CursorX,Y);
  1477.               {Ding;}
  1478.           end;  {If ID = 0};
  1479.      end; {with Table}
  1480.   end;  {proc change fields}
  1481.  
  1482.   Procedure Erase_Field(ID:byte);
  1483.   begin
  1484.       with Table[CurrentTable]^.FieldDefn[ID]^ do
  1485.       begin
  1486.           FieldStr := '';
  1487.           String_to_Var(ID);
  1488.           Set_Cursor(ID);
  1489.       end;
  1490.   end;
  1491.  
  1492.   Procedure Global_Erase;
  1493.   var
  1494.      I : integer;
  1495.      S : string;
  1496.      Ch : char;
  1497.   begin
  1498.       Ding;
  1499.       S := 'Erase all entries!  Are you sure? (Y/N)';
  1500.       With Table[CurrentTable]^.ITTT do
  1501.           TempMessageCh(1,ErrorLine,MsgFCol,MsgBCol,PadCenter(S,80,' '),CH);
  1502.       If Upcase(Ch) <> 'Y' then exit;
  1503.       with Table[CurrentTable]^ do
  1504.       begin
  1505.           For I :=  1 to ITTT.TotalFields do
  1506.               Erase_Field(I);
  1507.           Display_All_Fields;
  1508.           ITTT.CurrentField := 1;
  1509.       end;
  1510.   end;
  1511.  
  1512.   Procedure Cursor_Right;
  1513.   begin
  1514.       With Table[CurrentTable]^ do
  1515.            with FieldDefn[ITTT.CurrentField]^ do
  1516.            begin
  1517.               If (Right_Justify and (StrLocX < length(FieldStr)) and (StrLocX < FieldLen)) or
  1518.                  ((Right_Justify = false) and (StrLocX <= length(FieldStr)) and (StrLocX < FieldLen))then
  1519.               begin
  1520.                   Inc(StrLocX);
  1521.                   Repeat
  1522.                        Inc(CursorX);
  1523.                   Until FieldFmt[CursorX + 1 - X] in FmtChars;
  1524.               end;
  1525.               GotoXY(CursorX,Y);
  1526.           end; {with}
  1527.   end; {Proc Cursor_Right}
  1528.  
  1529.   Procedure Cursor_Left;
  1530.   begin
  1531.       with Table[CurrentTable]^ do
  1532.            With FieldDefn[ITTT.CurrentField]^ do
  1533.            begin
  1534.                If (StrLocX > 1)
  1535.                or ( Right_Justify and (StrLocX > 0) and (length(FieldStr) <> FieldLen) ) then
  1536.                begin
  1537.                    dec(StrLocX);
  1538.                    Repeat
  1539.                         dec(CursorX);
  1540.                    Until FieldFmt[CursorX + 1 - X] in FmtChars;
  1541.                end;
  1542.            end;  {with}
  1543.   end;  {Proc Cursor_left}
  1544.  
  1545.   Procedure Cursor_Home;
  1546.   var
  1547.     Counter1, Counter2 : byte;
  1548.   begin
  1549.       with Table[CurrentTable]^ do
  1550.            With FieldDefn[ITTT.CurrentField]^ do
  1551.                 Repeat
  1552.                      Counter1 := CursorX;
  1553.                      Cursor_Left;
  1554.                 Until Counter1 = CursorX;
  1555.   end;  {Proc Cursor_Home}
  1556.  
  1557.   Procedure Delete_Char;
  1558.   var
  1559.     I : integer;
  1560.   begin
  1561.       with Table[CurrentTable]^ do
  1562.            with FieldDefn[ITTT.CurrentField]^ do   {non format characters}
  1563.            begin
  1564.                If StrLocX > 0 then
  1565.                begin
  1566.                   Delete(FieldStr,StrLocX,1);
  1567.                   If Right_Justify then
  1568.                      Dec(StrLocX);
  1569.                end;
  1570.            end;  {with}
  1571.   end;  {Delete_Chars}
  1572.  
  1573.   Procedure Backspaced;
  1574.   begin
  1575.       with Table[CurrentTable]^ do
  1576.            with FieldDefn[ITTT.CurrentField]^ do
  1577.            begin
  1578.                If StrLocX > 1 then
  1579.                begin
  1580.                    If Right_Justify then
  1581.                    begin
  1582.                        Delete(FieldStr,pred(StrLocX),1);
  1583.                        Dec(StrLocX);
  1584.                    end
  1585.                    else
  1586.                    begin
  1587.                        Cursor_Left;
  1588.                        Delete(FieldStr,StrLocX,1);
  1589.                    end;
  1590.                end;
  1591.            end;  {with}
  1592.   end;  { Proc Backspaced }
  1593.  
  1594.   Procedure Finish_Input;
  1595.   {}
  1596.   var ValidInput : byte;
  1597.   begin
  1598. {$IFDEF IOFULL}
  1599.       Validate_Field(Table[CurrentTable]^.ITTT.CurrentField,ValidInput);
  1600.       If ValidInput = Valid then
  1601.       begin
  1602. {$ENDIF}
  1603.           String_to_Var(Table[CurrentTable]^.ITTT.CurrentField);
  1604.           Finished := true;
  1605. {$IFDEF IOFULL}
  1606.       end;
  1607. {$ENDIF}
  1608.   end; {of proc Finish_Input}
  1609.  
  1610.   Procedure Insert_Character(K : char);
  1611.   begin
  1612.       with Table[CurrentTable]^ do
  1613.            with FieldDefn[ITTT.CurrentField]^ do
  1614.            begin
  1615.                If (length(FieldStr) < FieldLen) then
  1616.                begin
  1617.                    If Right_Justify then
  1618.                    begin
  1619.                        Inc(StrLocX);
  1620.                        Insert(K,FieldStr,StrLocX);
  1621.                    end
  1622.                    else
  1623.                    begin
  1624.                        Insert(K,FieldStr,StrLocX);
  1625.                        Cursor_Right;
  1626.                    end;
  1627.                end
  1628.                else
  1629.                If (FieldLen = 1) then    {fix 5.00c}
  1630.                    FieldStr := K
  1631.                else
  1632.                    Ding;
  1633.       end;
  1634.   end;
  1635.  
  1636.   Procedure OverType_Character(K : char);
  1637.   begin
  1638.       with Table[CurrentTable]^ do
  1639.            with FieldDefn[ITTT.CurrentField]^ do
  1640.            begin
  1641.                If (StrLocX = 0) and Right_Justify then
  1642.                begin
  1643.                    Insert(K,FieldStr,StrLocX);
  1644.                    Inc(StrLocX);
  1645.                end
  1646.                else
  1647.                begin
  1648.                    Delete(FieldStr,StrLocX,1);
  1649.                    Insert(K,FieldStr,StrLocX);
  1650.                    Cursor_Right;
  1651.                end;
  1652.            end;
  1653.   end;
  1654.  
  1655.   Procedure Activity;
  1656.   var
  1657.     K : char;
  1658.     ReturnStr: string;
  1659.     Prior_CursorX : byte;
  1660.     ValidInput : byte;
  1661.     OldField : byte;
  1662.     CField : byte;
  1663.     Refresh: byte;
  1664.   begin
  1665.       OldField := Table[CurrentTable]^.ITTT.CurrentField;
  1666.       K := Getkey;
  1667.       {now the character hook}
  1668.       With Table[CurrentTable]^ do
  1669.       begin
  1670.           CField := ITTT.CurrentField;
  1671.           ReFresh := Refresh_None;
  1672.           {$IFNDEF VER40}
  1673.           ITTT.CharHook(K,CField,Refresh);
  1674.           {$ELSE}
  1675.           If IO_CharHook <> Nil then
  1676.               CallCharHook(K,CField,Refresh);
  1677.           {$ENDIF}
  1678.           Check_Refresh_State(Refresh);
  1679.           If CField <> ITTT.CurrentField then
  1680.              Change_Fields(CField); {user wants to go to a specific field}
  1681.           If K = ITTT.FinishChar then
  1682.              Finish_Input
  1683.           else
  1684. {$IFDEF IOFULL}
  1685.              If  (FieldDefn[ITTT.CurrentField]^.Allow_Char <> [#0])
  1686.              and (not (K in FieldDefn[ITTT.CurrentField]^.Allow_Char))
  1687.              and (not (K in Control_Char)) then
  1688.              begin
  1689.                  If K <> No_Char then          {5.00g}
  1690.                     Ding;
  1691.                  Exit;
  1692.              end;
  1693. {$ELSE}
  1694. ;
  1695. {$ENDIF}
  1696.       end;
  1697.  
  1698.       If (K <> No_Char)
  1699.       and (Finished = false) then
  1700.       begin
  1701.           If Extended then
  1702.           begin
  1703.           Case K of
  1704.           #132   {mouse right but}
  1705.                 : If Table[CurrentTable]^.ITTT.AllowEsc then
  1706.                      begin
  1707.                          Finished := true;
  1708.                       end
  1709.                       else Ding;
  1710.  
  1711.           #133,      {mouse left but}
  1712.           #131,      {mouse right}
  1713.           IORightFld
  1714.                  :  with Table[CurrentTable]^ do
  1715.                          Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1716.           #130,      {mouse left}
  1717.           IOLeftFld,
  1718.           IOShiftTab : with Table[CurrentTable]^ do
  1719.                            Change_Fields(FieldDefn[ITTT.CurrentField]^.LeftField);
  1720.           IODel    : Delete_Char;
  1721.           IOLeft   : Cursor_Left;
  1722.           IORight  : Cursor_Right;
  1723.           #128,    {mouse up}
  1724.           IOUp     : with Table[CurrentTable]^ do
  1725.                           Change_Fields(FieldDefn[ITTT.CurrentField]^.UpField);
  1726.           #129,    {mouse down}
  1727.           IODown   : with Table[CurrentTable]^ do
  1728.                           Change_Fields(FieldDefn[ITTT.CurrentField]^.DownField);
  1729.           IOErase    :with Table[CurrentTable]^ do
  1730.                            Erase_Field(ITTT.CurrentField);
  1731.           IOTotErase : Global_Erase;
  1732.           IOIns      : with Table[CurrentTable]^ do
  1733.                        begin
  1734.                            ITTT.Insert := not ITTT.Insert;
  1735.                            {$IFNDEF VER40}
  1736.                            ITTT.InsertProc(ITTT.Insert);
  1737.                            {$ELSE}
  1738.                             If IO_InsertHook <> Nil then
  1739.                                CallInsertHook(ITTT.Insert);
  1740.                            {$ENDIF}
  1741.                        end;
  1742.           #199       : Cursor_Home;
  1743.           #207       : with Table[CurrentTable]^ do
  1744.                           Set_Cursor(ITTT.CurrentField);
  1745.           else Ding;
  1746.       end; {case}
  1747.       end
  1748.       else                        {ordinary character}
  1749.       begin
  1750.          case K of
  1751.           IOEsc : If Table[CurrentTable]^.ITTT.AllowEsc then
  1752.                      begin
  1753.                          Finished := true;
  1754.                       end
  1755.                       else Ding;
  1756.           IOBackSp : Backspaced;
  1757.           IOTab,
  1758.           IOEnter :  with Table[CurrentTable]^ do
  1759.                          Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1760.           #32..#255 : with Table[CurrentTable]^ do
  1761.                 with FieldDefn[ITTT.CurrentField]^ do
  1762.                 begin
  1763.                     If FieldFmt[CursorX - X + 1] = '!' then K := upcase(K);
  1764.           {$IFDEF IOFULL}
  1765.                     If (
  1766.                          (Allow_Char = [#0])
  1767.                          or ((Allow_Char <> [#0]) and (K in Allow_Char))
  1768.                        )
  1769.                     and
  1770.                        (
  1771.                          (DisAllow_Char = [#0])
  1772.                          or ((DisAllow_Char <> [#0]) and ((K in DisAllow_Char)= false))
  1773.                        )
  1774.                     then
  1775.                     begin
  1776.            {$ENDIF}
  1777.                         If ((K in ['0'..'9','.','-','e','E']) and (FieldFmt[CursorX - X + 1] = '#'))
  1778.                         or (((K in ['a'..'z','A'..'Z',' ',',','.',';',':']) or (K in IntCharacters )) and
  1779.                                                   (FieldFmt[CursorX - X + 1] = '@'))
  1780.                         or (FieldFmt[CursorX - X + 1] = '*')
  1781.                         or (FieldFmt[CursorX - X + 1] = '!') then
  1782.                         begin
  1783.            {$IFDEF IOFULL}
  1784.                             If FirstCharPress then
  1785.                             begin
  1786.                                 If Erase_Default then
  1787.                                    Erase_Field(ITTT.CurrentField);
  1788.                                 FirstCharPress := false;
  1789.                             end;
  1790.             {$ENDIF}
  1791.                             If (ITTT.Insert) then
  1792.                                Insert_Character(K)
  1793.                             else
  1794.                                OverType_Character(K);
  1795.                         end
  1796.                         else Ding; {end if K in statement}
  1797.             {$IFDEF IOFULL}
  1798.                     end; {if}
  1799.             {$ENDIF}
  1800.                 end;  {with}
  1801.  
  1802.          end; {case}
  1803.       end;
  1804.       end;
  1805.       HiLight(Table[CurrentTable]^.ITTT.CurrentField);
  1806.       with Table[CurrentTable]^ do
  1807.            with FieldDefn[ITTT.CurrentField]^ do
  1808.                 GotoXY(CursorX,Y);
  1809.       
  1810. {$IFDEF IOFULL}
  1811.       with Table[CurrentTable]^ do
  1812.            with FieldDefn[ITTT.CurrentField]^ do
  1813.            begin
  1814.                If  (FirstCharPress = false)
  1815.                and (Jump_Full)
  1816.                and (StrLocX = FieldLen)
  1817.                and (Length(FieldStr) = FieldLen)
  1818.                and (ITTT.Insert)
  1819.                and (K in [#32..#126])
  1820.                and (Jump_Full) then
  1821.                    Change_Fields(FieldDefn[ITTT.CurrentField]^.RightField);
  1822.            end;
  1823. {$ENDIF}
  1824.       If Table[CurrentTable]^.ITTT.CurrentField <> OldField then  {5.00l}
  1825.          FirstCharPress := true
  1826.       else
  1827.          FirstCharPress := false;
  1828.       I_Char := K;
  1829.   end;    {Proc Activity}
  1830.  
  1831.  
  1832. begin   {Process_Input}
  1833.     If not TableSet then
  1834.         IOTTT_Error(14,0.0);  {5.01}
  1835.     with Table[CurrentTable]^ do
  1836.     begin
  1837.         If ITTT.Displayed = false then Display_All_Fields;
  1838.         If StartField in [1..ITTT.TotalFields] then
  1839.            ITTT.CurrentField := StartField
  1840.         else
  1841.            StartField := 1;
  1842.         {Enter Field Hook}        {5.00m}
  1843.         SField := StartField;
  1844.         Finished := false;
  1845.         Repeat
  1846.              ITTT.CurrentField := SField;
  1847.              SRefresh := Refresh_None;
  1848.              {$IFNDEF VER40}
  1849.              ITTT.EnterFieldHook(SField,SRefresh);
  1850.              {$ELSE}
  1851.              If IO_EnterHook <> Nil then
  1852.                 CallEnterFieldHook(SField,SRefresh);
  1853.              {$ENDIF}
  1854.              Check_Refresh_State(SRefresh);
  1855.              If Finished then exit;
  1856.         until SField = ITTT.CurrentField;
  1857.         Hilight(ITTT.CurrentField);
  1858.         If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then
  1859.         DisplayMessage(Table[CurrentTable]^.ITTT.CurrentField);
  1860.         GotoXY(FieldDefn[ITTT.CurrentField]^.CursorX,
  1861.                FieldDefn[ITTT.CurrentField]^.Y);
  1862.         FirstCharPress := true;
  1863.         {$IFNDEF VER40}                          {5.00j}
  1864.         ITTT.InsertProc(ITTT.Insert);
  1865.         {$ELSE}
  1866.         If IO_InsertHook <> Nil then
  1867.            CallInsertHook(ITTT.Insert);
  1868.         {$ENDIF}
  1869.         repeat
  1870.              Activity;
  1871.         until Finished;
  1872.         If FieldDefn[ITTT.CurrentField]^.MsgX <= 80 then   {5.02d}
  1873.              RemoveMessage(ITTT.CurrentField);
  1874.     end;
  1875. end;   {Process_Input}
  1876.  
  1877. begin  {Initial Auto proc}
  1878.     CurrentTable := 1;
  1879.     TableSet := False;
  1880. end.
  1881.  
  1882.